home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1993 December
/
PSL Monthly Shareware CD-ROM (December 1993).iso
/
prgmming
/
dos
/
pascal
/
complxo.exe
/
CDEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-01-15
|
13KB
|
412 lines
{$N+,E+}
PROGRAM cdemo;
{This PROGRAM demonstrates the use of the ComplexOps UNIT.
(C) Copyright 1990, 1992, Earl F. Glynn, Overland Park, KS. Compuserve 73257,3527.
All rights reserved. This program may be freely distributed only for
non-commercial use.}
USES ComplexOps;
VAR
a : ARRAY[1..22] OF Complex;
csave : ARRAY[1..22] OF Complex;
k,m : WORD;
n : INTEGER;
x,y : RealType;
z,z1,z2: Complex;
BEGIN
WRITELN ('Demo ComplexOPs PROCEDUREs and FUNCTIONs');
WRITELN;
WRITELN (' Notes: 1. CIS(w) = COS(w) + i*SIN(w), w = -PI..PI');
WRITELN (' 2. z = x + i*y');
WRITELN;
WRITELN;
CSet (a[ 1], 0.0, 0.0, rectangular);
CSet (a[ 2], 0.5, 0.5, rectangular);
CSet (a[ 3], -0.5, 0.5, rectangular);
CSet (a[ 4], -0.5, -0.5, rectangular);
CSet (a[ 5], 0.5, -0.5, rectangular);
CSet (a[ 6], 1.0, 0.0, rectangular);
CSet (a[ 7], 1.0, 1.0, rectangular);
CSet (a[ 8], 0.0, 1.0, rectangular);
CSet (a[ 9], -1.0, 1.0, rectangular);
CSet (a[10], -1.0, 0.0, rectangular);
CSet (a[11], -1.0, -1.0, rectangular);
CSet (a[12], 0.0, -1.0, rectangular);
CSet (a[13], 1.0, -1.0, rectangular);
CSet (a[14], 5., 0., rectangular);
CSet (a[15], 5., 3., rectangular);
CSet (a[16], 0., 3., rectangular);
CSet (a[17], -5., 3., rectangular);
CSet (a[18], -5., 0., rectangular);
CSet (a[19], -5., -3., rectangular);
CSet (a[20], 0., -3., rectangular);
CSet (a[21], -5., -3., rectangular);
CSet (a[22], -20., 20., rectangular);
WRITELN ('Complex number definition/conversion/output: CSet/CConvert/CStr');
WRITELN;
WRITELN (' z rectangular':25,'z polar':28);
WRITELN (' --------------------------- ',
'-----------------------------');
FOR k := 1 TO 21 DO
WRITELN (k:3,' ',CStr(a[k],12,8,rectangular),' ',
CStr(a[k],12,8,polar));
WRITELN;
WRITELN;
WRITELN ('Complex arithmetic: CAdd, CSub, CMult, CDiv');
WRITELN;
CSet (z1, 1, 1, rectangular);
WRITELN ('Let z1 = ':12,CStr(z1,8,3,rectangular):20,' or ',
CStr(z1,8,3,polar));
CSet (z2, SQRT(3), -1, rectangular);
WRITELN ('z2 = ':12,CStr(z2,8,3,rectangular):20,' or ',
CStr(z2,8,3,polar));
WRITELN;
CAdd (z,z1,z2);
WRITELN ('z1 + z2 = ':12,CStr(z,8,3,rectangular):20,' or ',
CStr(z,8,3,polar));
CSub (z,z1,z2);
WRITELN ('z1 - z2 = ':12,CStr(z,8,3,rectangular):20,' or ',
CStr(z,8,3,polar));
CMult (z,z1,z2);
WRITELN ('z1 * z2 = ':12,CStr(z,8,3,rectangular):20,' or ',
CStr(z,8,3,polar));
CDiv (z,z1,z2);
WRITELN ('z1 / z2 = ':12,CStr(z,8,3,rectangular):20,' or ',
CStr(z,8,3,polar));
WRITELN;
WRITELN;
WRITELN ('Complex natural logarithm: CLn = LN(z)');
WRITELN;
WRITELN (' Notes: 1. LN(z) is multivalued.');
WRITELN (' ':9,' 2. Any multiple of 2*PI*i could be added to/',
'subtracted from LN(z).');
WRITELN (' ':9,' 3. LN(1)=0; LN(-1)=PI*i; LN(+/-i)=+/-0.5*PI*i.');
WRITELN;
WRITELN ('LN(z)':35);
WRITELN ('z':11,'rectangular':27,'EXP( LN(z) ) = z':32);
WRITELN (' ------------ --------------------------- ',
'---------------------------');
FOR k := 1 TO 22 DO BEGIN
WRITE (k:3,' ',CStr(a[k],5,1,rectangular),' ');
IF CAbs(a[k]) = 0.0
THEN WRITELN ('undefined':18)
ELSE BEGIN
CLn (z,a[k]);
CExp (z1,z);
WRITELN (CStr(z,12,9,rectangular),' ',CStr(z1,12,9,rectangular))
END
END;
WRITELN;
WRITELN;
WRITELN ('Complex exponential: CExp = EXP(z)');
WRITELN;
WRITELN ('EXP(z)':35);
WRITELN ('z':11,'rectangular':27,'LN( EXP(z) ) = z':32);
WRITELN (' ------------ --------------------------- ',
'---------------------------');
FOR k := 1 TO 22 DO BEGIN
WRITE (k:3,' ',CStr(a[k],5,1,rectangular),' ');
CExp (z,a[k]);
CLn (z1,z);
IF CAbs(z) > 10.0
THEN m := 7
ELSE m := 9;
WRITELN (CStr(z,12,m,rectangular),' ',CStr(z1,12,m,rectangular))
END;
WRITELN;
WRITELN;
WRITELN ('Complex power: CPwr = z1^z2');
WRITELN;
WRITELN ('z^(-1+i)':36,'z^(-1+i)':29);
WRITELN ('z':11,'rectangular':27,'polar':26);
WRITELN (' ------------ --------------------------- ',
'-----------------------------');
CSet (z1, -1,1, rectangular);
FOR k := 1 TO 21 DO BEGIN
WRITE (k:3,' ',CStr(a[k],5,1,rectangular),' ');
IF CAbs(a[k]) = 0.0
THEN WRITELN ('undefined':18)
ELSE BEGIN
CPwr (z,a[k],z1);
WRITELN (CStr(z,12,9,rectangular),' ',CStr(z,12,9,polar))
END
END;
WRITELN;
WRITELN;
WRITELN ('Complex cosine: CCos = COS(z)');
WRITELN;
WRITELN ('COS(z)':35,'COS(z)':29);
WRITELN ('z':11,'rectangular':27,'polar':26);
WRITELN (' ------------ --------------------------- ',
'-----------------------------');
FOR k := 1 TO 21 DO BEGIN
WRITE (k:3,' ',CStr(a[k],5,1,rectangular),' ');
CCos (z,a[k]);
CIntPwr (csave[k], z,2); {save COS^2}
IF CAbs(z) > 10.0
THEN m := 7
ELSE m := 9;
WRITELN (CStr(z,12,m,rectangular),' ',CStr(z,12,m,polar))
END;
WRITELN;
WRITELN;
WRITELN ('Complex sine: CSin = SIN(z)');
WRITELN;
WRITELN ('SIN(z)':35);
WRITELN ('z':11,'rectangular':27,'SIN^2(z)+COS^2(z)=1':32);
WRITELN (' ------------ --------------------------- ',
'---------------------------');
FOR k := 1 TO 21 DO BEGIN
WRITE (k:3,' ',CStr(a[k],5,1,rectangular),' ');
CSin (z,a[k]);
CIntPwr (z1, z,2); {SIN^2}
CAdd (z1, z1,csave[k]); {SIN^2 + COS^2}
IF CAbs(z) > 10.0
THEN m := 7
ELSE m := 9;
WRITELN (CStr(z,12,m,rectangular),' ',CStr(z1,12,9,rectangular))
END;
WRITELN;
WRITELN;
WRITELN ('Complex tangent: CTan = TAN(z)');
WRITELN;
WRITELN ('TAN(z)':35,'TAN(z)':29);
WRITELN ('z':11,'rectangular':27,'polar':26);
WRITELN (' ------------ --------------------------- ',
'-----------------------------');
FOR k := 1 TO 21 DO BEGIN
WRITE (k:3,' ',CStr(a[k],5,1,rectangular),' ');
CTan (z,a[k]);
IF CAbs(z) > 10.0
THEN m := 7
ELSE m := 9;
WRITELN (CStr(z,12,m,rectangular),' ',CStr(z,12,m,polar))
END;
WRITELN;
WRITELN;
WRITELN ('Complex hyperbolic cosine: CCosh = COSH(z)');
WRITELN;
WRITELN ('COSH(z)':36,'COSH(z)':29);
WRITELN ('z':11,'rectangular':27,'polar':26);
WRITELN (' ------------ --------------------------- ',
'-----------------------------');
FOR k := 1 TO 21 DO BEGIN
WRITE (k:3,' ',CStr(a[k],5,1,rectangular),' ');
CCosh (z,a[k]);
CIntPwr (csave[k], z,2); {save COSH^2}
IF CAbs(z) > 10.0
THEN m := 7
ELSE m := 9;
WRITELN (CStr(z,12,m,rectangular),' ',CStr(z,12,m,polar))
END;
WRITELN;
WRITELN;
WRITELN ('Complex hyperbolic sine: CSinh = SINH(z)');
WRITELN;
WRITELN ('SINH(z)':36);
WRITELN ('z':11,'rectangular':27,'COSH^2(z)-SINH^2(z)=1':34);
WRITELN (' ------------ --------------------------- ',
'---------------------------');
FOR k := 1 TO 21 DO BEGIN
WRITE (k:3,' ',CStr(a[k],5,1,rectangular),' ');
CSinh (z,a[k]);
CIntPwr (z1, z,2); {SINH^2}
CSub (z1, csave[k],z1); {COSH^2 - SINH^2}
IF CAbs(z) > 10.0
THEN m := 7
ELSE m := 9;
WRITELN (CStr(z,12,m,rectangular),' ',CStr(z1,12,9,rectangular))
END;
WRITELN;
WRITELN;
WRITELN ('Complex hyperbolic tangent: CTanh = TANH(z)');
WRITELN;
WRITELN ('TANH(z)':36,'TANH(z)':29);
WRITELN ('z':11,'rectangular':27,'polar':26);
WRITELN (' ------------ --------------------------- ',
'-----------------------------');
FOR k := 1 TO 21 DO BEGIN
WRITE (k:3,' ',CStr(a[k],5,1,rectangular),' ');
CTanh (z,a[k]);
IF CAbs(z) > 10.0
THEN m := 4
ELSE m := 9;
WRITELN (CStr(z,12,m,rectangular),' ',CStr(z,12,m,po